home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / edit / paint.zip / PTUTILS.PAS < prev    next >
Pascal/Delphi Source File  |  1987-11-18  |  5KB  |  157 lines
  1. { this is a set of utilities (procedures) used by PAINT.
  2.     Window (num, MenuItem)
  3.     ResetWin (num)
  4.     ClrWin (num)
  5.     flash (prompt)
  6.     getchar (prompt) --> char
  7.     verify (MenuItem) --> boolean
  8.  
  9.     dab (x,y, brush)
  10.     wpage (width, height)
  11.     boxpage (width, height)
  12. }
  13.  
  14. procedure window ( num : WinID; message : MenuItem);
  15.     { write a message on the next line of the indicated window }
  16.     begin
  17.         GoToXY (RIGHT-WinWidth, linecount [num]);
  18.         write (message);
  19.         linecount [num] := linecount[num] +1;
  20.     end;
  21.  
  22. procedure ResetWin (num : WinID);
  23.     begin
  24.         if num=1 then linecount [1] := 1
  25.             else      linecount [2] := WinHite + 1;
  26.     end;
  27.  
  28. procedure ClrWin (num : WinID);
  29.     var    x,y, ymin,ymax : integer;
  30.     begin
  31.         if num=1 then begin  ymin:=1; ymax:=WinHite;  end
  32.            else   begin  ymin:=WinHite+1; ymax:=25;  end;
  33.         for y:=ymin to ymax do
  34.         begin
  35.             GoToXY (RIGHT-WinWidth, y);
  36.             for x:=1 to WinWidth do  write (' ');
  37.         end;
  38.         linecount [2] := WinHite + 1;
  39.     end;
  40.  
  41. procedure flash (msg : prompt);
  42.   { show a 5-line message in window 2 for  3 seconds }
  43.     var    i : integer;
  44.     begin
  45.         ClrWin (2);
  46.         for i:=1 to 5 do
  47.             window (2, msg [i]);
  48.         delay (3000);
  49.         ClrWin (2);
  50.     end;
  51.  
  52. function getchar (msg : prompt) : char;
  53.   { puts a 5-line prompt on the screen, then waits for keystroke }
  54.   { returns the result of the keystroke  }
  55.     var    i : integer;
  56.            inchar : char;
  57.     begin
  58.         ClrWin (2);
  59.         ErrMsg := msg [1];  (* will be displayed by "blink" *)
  60.         window (2, '');
  61.         for i:=2 to 5 do
  62.             window (2, msg [i]);
  63.         blink;
  64.         read (kbd, inchar);
  65.         getchar := inchar;
  66.     end;
  67.  
  68. function verify (msg : MenuItem) : boolean;
  69.     var    inchar : char;
  70.     begin
  71.         ClrWin (2);
  72.         window (2, msg);
  73.         window (2, '  (Y/N)');
  74.         read (kbd, inchar);
  75.         if (inchar='y') or (inchar='Y') then verify := TRUE
  76.                                         else verify := FALSE;
  77.         ClrWin (2);
  78.     end;
  79.  
  80.  
  81. procedure dab (x,y,brush : integer);
  82.     type   brushes = array [0..MAXBRUSH, 0..2] of byte;
  83.            mask  =  array [0..1] of byte;
  84.     const  b_palette : brushes = ((0,0,0),     (* brush = 0  *)
  85.                                 (0,0,0),     (*   "   " 1  *)
  86.                                 (8,0,2),     (*         2  *)
  87.                                 (10,5,10),   (*         3  *)
  88.                                 (7,11,13),   (*         4  *)
  89.                                 (15,15,15),  (*         5  *)
  90.                                 (0,0,0),     (*         6  *)
  91.                                 (0,0,0),     (*         7  *)
  92.                                 (0,0,0),     (*         8  *)
  93.                                 (0,0,0),     (*         9  *)
  94.                                 (2,2,2),     (*  10 = |    *)
  95.                                 (0,15,0),    (*  11 = -    *)
  96.                                 (2,15,2),    (*  12 = +    *)
  97.                                 (8,6,1),     (*  13 = \    *)
  98.                                 (1,6,8),     (*  14 = /    *)
  99.                                 (9,6,9));     (*  15 = X    *)
  100.            half : mask = ($F0, $0F);
  101.            shifter : mask = (16,1);
  102.            PIXBASE = $B800;
  103.     var    xodd, yodd, bytA : integer;
  104.            xmap, ymap : integer;
  105.            j : integer;
  106.            point : ^byte;
  107.     begin
  108.         ymap := y*ycell;   (* ymap = row of raster *)
  109.         xmap := x div 2;   (* xmap = byte in x-raster *)
  110.         xodd := x mod 2;   (* left or right half of byte *)
  111.         for j:=0 to 2 do
  112.         begin
  113.             (* get a pointer to the byte to be modified *)
  114.             yodd := ymap mod 2;
  115.             bytA := ymap div 2 * 80  +  yodd * 8192  +  xmap;
  116.             point := ptr (PIXBASE, bytA);
  117.  
  118.             (* now write the palette entry into the half-byte *)
  119.             point^ := (point^ and half [1-xodd]) or
  120.                         (b_palette [brush, j] * shifter [xodd]);
  121.             ymap := ymap + 1;    (* bump the line counter *)
  122.         end;
  123.     end;
  124.  
  125. procedure wpage (width, hite : integer);
  126.     { wpage whites out the page for background color }
  127.     const  PIXBASE = $B800;
  128.     var    x,y : integer;
  129.            bytA : ^byte;
  130.     begin
  131.         for x:=0 to (width div 8) do
  132.             for y:=0 to (hite div 2) do
  133.             begin
  134.                 bytA:=ptr(PIXBASE, y*80 + x);
  135.                 bytA^:=255;
  136.                 bytA:=ptr(PIXBASE, $2000 + y*80 +x);
  137.                 bytA^:=255;
  138.             end;
  139.     end;
  140.  
  141. procedure boxpage (width, hite : integer);
  142.     { boxpage takes a black-bkgnd page and outlines it }
  143.     var    x,y : integer;
  144.     begin
  145.         for x:=0 to (width-1) do
  146.         begin
  147.             pixel (x, 0, 1);
  148.             pixel (x, hite-1, 1);
  149.         end;
  150.         for y:=0 to (hite-1) do
  151.         begin
  152.             pixel (0, y, 1);
  153.             pixel (width-1, y, 1);
  154.         end;
  155.     end;
  156.  
  157.